perm filename HISFFT.SAI[3,ALS] blob
sn#050677 filedate 1973-06-24 generic text, type T, neo UTF8
00100 BEGIN "FIX"
00200 DEFINE ⊂="COMMENT"; ⊂ 6/29/72;
00300 ⊂ This is a fast version of LIS.SAI which creates condensed files .D64 ;
00400 REQUIRE "COMSUB.HDR[1,THO]" SOURCE_FILE;
00510
00540
00600
00700 REQUIRE "NEWPRE" LOAD_MODULE;
00905 EXTERNAL PROCEDURE SPOOL(STRING S; INTEGER IOCHAN,FLAGS);
00950
01400 INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
01500
01600 EXTERNAL PROCEDURE PREPARE;
01700 ⊂ EXTERNAL PROCEDURE SETBR;
01800 ⊂ EXTERNAL REAL PROCEDURE RUNTIM;
01900 EXTERNAL STRING PROCEDURE INCHWL;
02000
02100 DEFINE BPS="12";
02200 DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323",INSIZ="32";
02300 DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)";
02400 DEFINE LBYT="ILDB(LBPT)";
02500 DEFINE LBYTE="((ILDB(LBPT) LSH 24)%2↑24)";
02700
02750 INTEGER ARRAY COUNT[0:24,0:128];
02780 INTEGER ARRAY SUM[0:21];
02790 INTEGER BIN;
02795
02800 STRING FILEL,FILI,TFILEI,TFILE,FILEI,OPT0,OPT1,OPT2,OPT3;
02900 ⊂ INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
03000 INTERNAL INTEGER ARRAY LIST[0:INSIZ];
03100 ⊂ INTEGER ARRAY INDATA[0:640];
03200 INTEGER ARRAY LFILE[0:'177];
03300 INTERNAL REAL ARRAY C[0:256];
03400 INTERNAL REAL X,SX;
03600 INTERNAL INTEGER ARRAY INNAM[0:INSIZ];
03700 INTERNAL INTEGER ARRAY INCNT,INSUB,INDIV,INRAW,INDAT[0:INSIZ];
03800 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,EOF,IEOF,EOFA,BRK;
03900 INTEGER BPT,BPTFST,BPTSAV,LBPT,SEGCNT,SEGTOT;
04000 INTEGER H,I,J,K,L,ZZ;
04100 INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG;
04200 INTERNAL INTEGER SEGC,SEGMRK,SEGSAV;
04300 INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH;
04400 INTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,
04500 ILPB,ILPC, IHPB,IHPC ;
04600 INTERNAL INTEGER NF; ⊂ *** USED IN PREPARE;
04700 INTERNAL INTEGER TFLAG;
04800 INTERNAL INTEGER ZEROF,ZEROC;
04900 INTERNAL REAL R0 ;
05000 INTERNAL INTEGER NP,NZ,FP1,FP2,FZ ; INTERNAL REAL NPA,NZA,FP1A,FP2A,FZA, LPE,HPE,AVE ;
05100 INTERNAL INTEGER ARRAY FF[1:5] ; INTERNAL REAL ARRAY AMP[1:5] ;
05200 LABEL START;
05300 STRING READ1,READ2,PREHINT,STEPX,STPMOD;
05400 INTEGER HINCNT,HCOUNT,HINDEX;
05500
05600
05700 COMMENT MACROS;
05800 DEFINE ⊂="COMMENT",CR="'15",LF="'12",TB="'11";
05900 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
06000 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
06100 DEFINE TIL="STEP 1 UNTIL";
06200 DEFINE BDSK="'10",GPH="'11",DSKO="GPH",HP="'7",HPLIST="'6",MUS="'4",ED="'3";
06300 INTEGER K.,J.; ⊂ USED IN MACROS;
06400 DEFINE ERROR(I)="OUT(TTY,""ERROR""&CVS(I))";
06500 DEFINE ISQRT(I)="(K.←(I)↑0.5)";
06600 DEFINE ODD(I)="((I) MOD 2)", EVEN(I)="¬ODD(I)";
06700 DEFINE ABS(I)="(IF I<0 THEN -I ELSE I)";
06800 DEFINE NONNEG(I)="(IF I<0 THEN 0 ELSE I)";
06900 DEFINE TRACE(N)="OUTSTR(""[""&CVS(N)&""]""(";
07000 DEFINE LTRACE(N)="OUTSTR(CR&LF&""[""&CVS(N)&""]"")";
07100 DEFINE FTRACE(N)=
07200 "BEGIN INTEGER F1,F2; GETFORMAT(F1,F2); SETFORMAT(0,7);
07300 OUTSTR(""[""&CVF(N)&""]""); SETFORMAT(F1,F2) END";
07400 DEFINE DATE="DATIME(""DATE"")", TIME="DATIME(""TIME"")";
07500 DEFINE MOVEADR(ADR,ARRAY)="QUICK_CODE MOVE 11,ARRAY;MOVEM 11,ADR;END";
07600 DEFINE PI="3.141592653",PICON="(PI/180)";
07700 DEFINE INFINITY="'377777777777";
07800 STRING PARMS; ⊂ HOLDS CONTENTS OF PARMFILE;
07900
08000
08100
08200
08300 STRING PROCEDURE HEADER;
08400 BEGIN STRING H1,H2; INTEGER I,J,K;
08500 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; RETURN(PREHINT) END
08600 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
08700 I←LFILE[HINDEX]; K←LDB(POINT(7,I,30)); J←SEGC-K;
08800
08900 IF I=0 THEN BEGIN PREHINT←""; HCOUNT←99; RETURN(PREHINT) END;
09000 IF J ≥ 0 THEN BEGIN "LATCH"
09100 H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
09200 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
09300 IF EQU(H1,H2) THEN BEGIN PREHINT←H1; HCOUNT←LDB(POINT(5,I,35));
09400 HCOUNT←HCOUNT-J;
09500 HINDEX←HINDEX+1; RETURN(PREHINT); DONE
09600 END
09700 ELSE BEGIN PREHINT←""; HCOUNT←LDB(POINT(5,I,35));
09800 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE;
09900 END;
10000 END "LATCH";
10100 PREHINT←""; RETURN(PREHINT); END "XX";
10200 END "HEADER";
10300
10400
00100 SETBR;
00200
00300
00600 UPCNT←3;
00700 FILEL←"LIST1";
00800 FILEI←"TOO1.DAT[1,THO]"; OPT1←"N"; OPT2←"N"; OPT3←"0"; M←8; INFLAG←0;
00900 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
01000
01050 BIN←16;
01100 IF (TFILEI←STRINGIN("Number of bins (CR for 16) =? "))≠"" then bin←cvd(tfilei);
01200 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
01300 LOOKIN(CHAN5,FILEL); EOFA←0;
01400
01500 M←8;
01600 N←2↑M; NF←2*N;
02900 N←2↑M;
03100 DATSHIFT←0;
03200 OUTSTR(CRLF);
03300
03310 CLOSE(CHAN2); OPEN(CHAN2,"DSK",0,0,'10,0,0,0);
03320 ENTER(CHAN2,"HISTRY.DAT",0);
03330 OUT(CHAN2,"Histograph in parts per 512 with "&cvs(BIN)&" bins."
03365 &TB&DATE&CRLF&LF&"Based on files ");
03400 START:
03500 WHILE EOFA=0 DO BEGIN "LISTREAD" INTEGER FFTCNT; REAL ARRAY FFTBUF[1:1290];
03600 HINDEX←21; HCOUNT←HINCNT←0; OPT1←"Y"; OPT2←"N"; STEPX←"Y";
03700 FILEI←INPUT(CHAN5,1);
04600
04650 IF FILEI="" THEN DONE; IF FILEI ="END" THEN DONE;
04700 CLOSE(CHAN4);
04800 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
04900 LOOKIN(CHAN4,FILEI);
05000 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
05100 EOF←0; SEGC←0; SEGCNT←0;
05200 SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
05300
05400 IF RATE=0 THEN RATE←CVD(STRINGIN("Sampling rate missing. Rate = "));
05500 OUTSTR("Data file "&FILEI&" with "&CVS(SEGTOT)&" half segments"&CRLF);
05600 ⊂ ****Create condensed files ;
06600 SETFORMAT(1,0);
06610
06620
06720 OUT(CHAN2," "&FILEI);
07100 BEGIN "FFT" INTEGER ARRAY INDATA[0:SEGTOT*4];
07105 ⊂ **** SET PARAMETER RANGES
07110 THE PARA LIMITS ARE (DOUBLE CHECK) F1=200/800 F2=700/2050 F3=2000/3200
07115 NP=800/1500 NZRNG=NP+/-500 ?
07120 FP1=1800/3200 FP2=3200/5000 LPE=300/450 HPE=2500/3000 ;
07125 ⊂ *** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
07130 SX←RATE/N; I1L←200./SX ; I1H←800./SX+.5 ; I2L←700./SX; I2H←2050./SX+.5;
07135 I3L←1950./SX; I3H←3250./SX+.5;
07140 INL←800./SX; INH←1500./SX+.5; NZRNG←500./SX+.5;
07145 FP1L←1800./SX; FP1H←3200./SX; FP2L←3200./SX+.5; FP2H←5000./SX+.5;
07150 ILPB←300./SX; ILPC←450./SX; IHPC←2500./SX; IHPB←3000./SX;
07300
07310
07320
07330 FOR I←0 STEP 1 UNTIL SEGTOT*4 DO INDATA[I]←0;
07340
07350
07360 SEGC←0;
07400 K←1; WHILE EOF=0 DO BEGIN "LP"
07500 ARRYIN(4,FFTBUF[1],1290); OUTSTR(CVS(K)&TB);
07600 IF EOF≠0 THEN FOR I←(EOF LAND '777777)+1 STEP 1 UNTIL 1290
07700 DO FFTBUF[I]←0.;
07800
07900 FOR I←0 STEP 1 UNTIL 9 DO BEGIN
08000 FOR J←0 STEP 1 UNTIL N/2 DO C[J]←FFTBUF[129*I+J+1];
08010
08020
08030 IF (C[0]≠0) THEN PREPARE ELSE
08035 FOR P←0 STEP 1 UNTIL 21 DO INDAT[P]←0;
08040 SEGC←SEGC+1; J←(SEGC-1)*4; L←0; IF SEGC>SEGTOT THEN DONE;
08100 FOR P←0 STEP 1 UNTIL 21 DO BEGIN
08110 IF INDAT[P]<0 THEN INDAT[P]←0 ELSE IF INDAT[P]>127 THEN INDAT[P]←127;
08130 J←INDAT[P]; COUNT[P,J]←COUNT[P,J]+1; sum[p]←sum[p]+1;
08140 END; ⊂ ENDS P 0 TO 23 LOOP;
08150
08160 END; ⊂ ENDS I 0 TO 9 LOOP;
08170
08180
08190
08200
08300 K←K+1; IF EOF≠0 THEN DONE; END "LP";
08400
08500
08600
08700
13000 END "FFT";
13200 OUTSTR(TFILE&" has been PROCESSED"&CRLF);
13300 IF EOFA≠0 THEN DONE;
13400 END "LISTREAD";
13510
13515 H←128/BIN;
13520 SETFORMAT(4,0);
13522 out(chan2,CRLF&LF&" Bin` In");
13525 FOR P←0 STEP 1 UNTIL 21 DO OUT(CHAN2,CVS(P));
13527 OUT(CHAN2,CRLF&LF);
13530 FOR J←0 STEP 1 UNTIL BIN-1 DO BEGIN
13540 OUT(CHAN2,CVS(J)&TB); I←J*H;
13550 FOR P←0 STEP 1 UNTIL 21 DO BEGIN
13560 ZZ←0;
13570 FOR K←0 STEP 1 UNTIL H-1 DO BEGIN
13580 L←I+K; ZZ←ZZ+COUNT[P,L]; END;
13585 ZZ←((ZZ*1024)/SUM[P]+1)/2;
13590 OUT(CHAN2,CVS(ZZ)); END;
13640 OUT(CHAN2,CRLF); END;
13740 OUT(CHAN2,CRLF&" Sums"&TB);
13840 FOR K←0 STEP 2 UNTIL 21 DO OUT(CHAN2,CVS(SUM[K])&" ");
13890 OUT(CHAN2,CRLF&TB&" ");
13915 FOR K←1 STEP 2 UNTIL 21 DO OUT(CHAN2,CVS(SUM[K])&" ");
13940 OUT(CHAN2,CRLF); CLOSE(CHAN2);
13970 COMMENT SPOOL("HISTRY.DAT",GETCHAN,0);
14000 END "FIX";